﻿(*******************************************************************************
* UOfficeExport v1.0 written by James Von (jamesvon@163.com) *******************
********************************************************************************
* TOfficeExport                                                                *
*------------------------------------------------------------------------------*
*     可以根据用户调用的模板或文件自动启用Excel或Word
*==============================================================================*
* 使用说明
*==============================================================================*
var
  VonOffice: TOfficeExport;
begin
  VonOffice:= TOfficeExport.OfficeExport(AFilename); //系统会根据文件后缀自动启用Word或Excel
  VonOffice.RegTable(<Prefix>, <DataSet>);           //注册一个数据库查询结果集
  VonOffice.RegData(<Prefix>, <Data>);               //注册一个 TVonTable 数据集
  VonOffice.RegCommand([<cmd_name>,[param]..[param]])//注册一个执行命令
  VonOffice.Execute;                                 //执行命令，完成数据输出
  VonOffice.Free;
end;
*------------------------------------------------------------------------------*
* <cmd_name> 说明
*------------------------------------------------------------------------------*
* ['WHILE',<Prefix>,<condition>]                //循环开始
* ['LOOP',<condition>]                          //循环结束
* ['WRITE',<prefix>,<page>,<exporttablekind>]   //写数据
* ['COPY',<copykind>,<page>,<params>]           //复制一个区域或页面到置顶页面
* ['INSROW',<page>,<row>,<count>]               //插入行
* ['INSCOL',<page>,<col>,<count>]               //插入列
* ['DELROW',<page>,<row>,<count>]               //删除行
* ['DELCOL',<page>,<col>,<count>]               //删除列
*                                       //
*------------------------------------------------------------------------------*
* <condition>: NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
*              数字=循环次数，循环次数变量名为LOOPID(n=循环层数)
* <copykind>: HRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
*             VRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
*             HPAGE=水平单页复制，后面参数为复制页页码 <page>
*             VPAGE=垂直单页复制，后面参数为复制页页码 <page>
*------------------------------------------------------------------------------*
  with TOfficeExport.OfficeExport(GetTemplateFilename('装炉顺序表')) do try
    RegTable('B', DQLoadTable);
    RegTable('C', DQItem);
    RegTable('D', DQItem);
    DQLoadTable.First;
    DQItem.First;
    RegCommand(['WHILE', 'B', 'NEOF']);
    RegCommand(['  COPY', 'VPAGE', '1', '2']);
    RegCommand(['  WRITE', 'B', '1', 'ONLY']);
    RegCommand(['  WHILE', 'C', '1', 'NEOF']);
    RegCommand(['    WRITE', 'C', '1', 'EROW']);
    RegCommand(['    MOVE', 'D', 'FIRST']);
    RegCommand(['    WRITE', 'D', '1', 'EROW']);
    RegCommand(['  LOOP']);
    RegCommand(['  MOVE', 'B', 'NEXT']);
    RegCommand(['LOOP']);
    Execute;
    FilePath:= FThDB.AppPath + 'TEMP\';
    SaveFile(FilePath + Filename);
  finally
    Free;
  end;
*------------------------------------------------------------------------------*
  with ExportTemplate('钢管出库单') do try
    RegTable('O', DQOut);
    Execute;
    Print;
  finally
    Free;
  end;
********************************************************************************)
unit UComOfficeExport;

interface

uses SysUtils, Variants, Classes, Graphics, Controls, ComObj, Forms, ADODB, DB,
  Windows, Dialogs, UVonLog, UVonConfig, OLE_Word_TLB, OLE_Excel_TLB;

type
  /// <summary>信息表类型</summary>
  /// <param name="ETK_ONLY">单一显示数据源</param>
  /// <param name="ETK_ROWS">多行填充数据源</param>
  /// <param name="ETK_COLS">多列填充数据源</param>
  /// <param name="ETK_EROW">多行扩展数据源</param>
  /// <param name="ETK_ECOL">多列扩展数据源</param>
  /// <param name="ETK_PAGE">多页显示数据源</param>
  /// <param name="ETK_RBLK">母页行段数据源</param>
  /// <param name="ETK_CBLK">母页列段数据源</param>
  EExportTableKind = (ETK_ONLY, ETK_ROWS, ETK_COLS, ETK_EROW, ETK_ECOL, ETK_PAGE, ETK_RBLK, ETK_CBLK);

  TOfficeExport = class
  private
    FRegList: TStringList;
    FCommandList: TVonArraySetting;
    FLoopList: TList;
    FCurrentLoop: Integer;
    FCurrentCom: Integer;
    FFilename: string;
    FFilePath: string;
    FRegisted: Boolean;
    procedure SetFilename(const Value: string);
    procedure SetFilePath(const Value: string);
    procedure FunWhile(Cmd: TArrayOfString; EndCmdIdx: Integer);                //循环开始
    procedure FunLoop(Cmd: TArrayOfString; BeginCmdIdx: Integer);               //循环结束
    procedure FunMoveData(Cmd: TArrayOfString);
  protected
    FOpened: Boolean;
    /// <summary>打开一个文件名称打开文档</summar  y>
    procedure Open(Filename: string); virtual; abstract;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); virtual; abstract;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteData(Prefix: string); overload;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteTable(Prefix: string); overload;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteData(Index: Integer); overload; virtual; abstract;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteTable(Index: Integer); overload; virtual; abstract;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); virtual; abstract;
    procedure Prepared; virtual; abstract;
    procedure FunWrite(Cmd: TArrayOfString);         virtual;                   //写数据
    procedure FunCopy(Cmd: TArrayOfString);          virtual;                   //复制一个区域或页面
    procedure FunInsertRow(Cmd: TArrayOfString);     virtual;                   //插入行
    procedure FunInsertCol(Cmd: TArrayOfString);     virtual;                   //插入列
    procedure FunDelRow(Cmd: TArrayOfString);        virtual;                   //删除行
    procedure FunDelCol(Cmd: TArrayOfString);        virtual;                   //删除列
  public
    constructor Create; virtual;
    destructor Destroy; virtual;
    /// <summary>通过文件名，自动创建输出函数</summary>
    class function OfficeExport(AFilename: string): TOfficeExport; static;
    /// <summary>注册一个数据库查询结果集</summary>
    /// <param name="Prefix">数据前缀</param>
    /// <param name="ADataSet">数据集</param>
    procedure RegTable(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>注册一个数据集</summary>
    /// <param name="Prefix">数据前缀</param>
    /// <param name="ADataSet<see>TVonTable</see>">数据集</param>
    procedure RegData(Prefix: string; ADataSet: TVonTable);
    /// <summary>注册执行命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure RegCommand(Cmd: array of string);
    /// <summary>打印当前文件</summary>
    procedure Print; virtual; abstract;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); virtual; abstract;
    /// <summary>关闭当前word文档</summary>
    procedure Close; virtual; abstract;
    /// <summary>开始写入注册数据</summary>
    procedure WriteData; overload;
    /// <summary>导出所有注册项目名称</summary>
    procedure WriteReg;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure DoCommand(Cmd: TArrayOfString);
    /// <summary>按顺序执行所有命令</summary>
    procedure Execute;
    /// <summary>清除所有注册命令及注册数据信息</summary>
    procedure Clear; virtual;
    procedure Debug;
  published
    property Filename: string read FFilename write SetFilename;
    property FilePath: string read FFilePath write SetFilePath;
    property Registed: Boolean read FRegisted;
    /// <summary>文件是否已经打开</summary>
    property Opened: Boolean read FOpened;
  end;

  TExcelExport = class(TOfficeExport)
  private
    FExcelApp: TExcelApplication;
    FExcelBook: TExcelWorkbook;
    FExcelSheet: TExcelWorksheet;
    LCID: Integer;
    FRowOffset: array[1..10] of Integer;
    FColOffset: array[1..10] of Integer;
    /// <summary>单一显示数据源</summary>
    procedure WriteONLYData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多行填充数据源</summary>
    procedure WriteROWSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多列填充数据源</summary>
    procedure WriteCOLSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多行扩展数据源</summary>
    procedure WriteEROWData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多列扩展数据源</summary>
    procedure WriteECOLData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多页显示数据源</summary>
    procedure WritePAGEData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteRBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteCBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    function GetCurrentSheet: TExcelWorksheet;
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteData(Index: Integer); overload; override;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteTable(Index: Integer); overload; override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
    procedure Prepared; override;
    procedure FunWrite(Cmd: TArrayOfString);         override;                  //写数据
    procedure FunCopy(Cmd: TArrayOfString);          override;                  //复制一个区域或页面
    procedure FunInsertRow(Cmd: TArrayOfString);     override;                  //插入行
    procedure FunInsertCol(Cmd: TArrayOfString);     override;                  //插入列
    procedure FunDelRow(Cmd: TArrayOfString);        override;                  //删除行
    procedure FunDelCol(Cmd: TArrayOfString);        override;                  //删除列
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
  published
    /// <summary>当前工作表</summary>
    property CurrentSheet: TExcelWorksheet read GetCurrentSheet;
  end;

  TWordExport = class(TOfficeExport)
  private
    FWordApp: TWordApplication;
    FWordBook: TWordDocument;
    /// <summary>单一显示数据源</summary>
    procedure WriteONLYData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多行填充数据源</summary>
    procedure WriteROWSData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多列填充数据源</summary>
    procedure WriteCOLSData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多行扩展数据源</summary>
    procedure WriteEROWData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多列扩展数据源</summary>
    procedure WriteECOLData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多页显示数据源</summary>
    procedure WritePAGEData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteRBLKData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteCBLKData(Prefix: string; ADataSet: TCustomADODataSet);
    function GetCurrentBook: TWordDocument;
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteData(Index: Integer); overload; override;
    /// <summary>开始写入注册数据</summary>
    /// <param name="Prefix">数据前缀</param>
    procedure WriteTable(Index: Integer); overload; override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
  published
    property CurrentBook: TWordDocument read GetCurrentBook;
  end;

implementation

{ TOfficeExport }

procedure TOfficeExport.Clear;
begin
  FRegList.Clear;
  FLoopList.Clear;
  FCommandList.Clear;
  FCurrentLoop:= 0;
  FCurrentCom:= 0;
  FFilename:= '';
  FFilePath:= '';
  FRegisted:= False;
end;

constructor TOfficeExport.Create;
begin
  FRegList:= TStringList.Create;
  FCommandList:= TVonArraySetting.Create;
  FLoopList:= TList.Create;
end;

procedure TOfficeExport.Debug;
var
  S: string;
  I: Integer;
begin
  for I := 0 to FCommandList.Count - 1 do
    S:= S + #13#10 + IntToStr(I) + ' : ' + FCommandList[I, 0] + '(' +
      IntToStr(Integer(FCommandList.Data[I])) + ')';
  ShowMessage(S);
end;

destructor TOfficeExport.Destroy;
begin
  FLoopList.Free;
  FCommandList.Free;
  FRegList.Free;
end;

procedure TOfficeExport.DoCommand(Cmd: TArrayOfString);
begin


end;

procedure TOfficeExport.Execute;
var
  I: Integer;
  Cmd: TArrayOfString;
begin
  FCurrentCom:= 0;
  FCurrentLoop:= -1;
  FLoopList.Clear;
  Prepared;
  WriteLog(LOG_DEBUG, 'TOfficeExport', ' ===================== BEGIN +++++++++++++++++');
  while FCurrentCom < FCommandList.Count do begin
    Cmd:= FCommandList.GetRow(FCurrentCom);
    WriteLog(LOG_DEBUG, 'TOfficeExport', Cmd[0]);
    if Cmd[0] = 'WHILE' then begin
      if FCurrentLoop > FCurrentCom then begin              //后面的循环结束，删除当前的循环次数
        FLoopList.Delete(FLoopList.Count - 1);
        FCurrentLoop:= FCurrentCom;
      end else if FCurrentLoop < FCurrentCom then begin     //新循环开始，添加一个
        FLoopList.Add(nil);
        FCurrentLoop:= FCurrentCom;
      end else
        FLoopList[FLoopList.Count - 1]:= Pointer(Integer(FLoopList[FLoopList.Count - 1]) + 1);
      FunWhile(Cmd, Integer(FCommandList.Data[FCurrentCom]));       //循环开始
    end else if Cmd[0] = 'LOOP' then FunLoop(Cmd, Integer(FCommandList.Data[FCurrentCom]))    //循环结束
    else if Cmd[0] = 'WRITE' then FunWrite(Cmd)           //写数据
    else if Cmd[0] = 'COPY' then FunCopy(Cmd)             //复制一个区域或页面
    else if Cmd[0] = 'INSROW' then FunInsertRow(Cmd)      //插入行
    else if Cmd[0] = 'INSCOL' then FunInsertCol(Cmd)      //插入列
    else if Cmd[0] = 'DELROW' then FunDelRow(Cmd)         //删除行
    else if Cmd[0] = 'DELCOL' then FunDelCol(Cmd)         //删除列
    else if Cmd[0] = 'MOVE' then FunMoveData(Cmd)         //移动数据游标
    else raise Exception.Create('Cannot execute commmand "' + '' + '"');
    Inc(FCurrentCom);
  end;
end;

procedure TOfficeExport.FunCopy(Cmd: TArrayOfString);
begin

end;

procedure TOfficeExport.FunDelCol(Cmd: TArrayOfString);
begin

end;

procedure TOfficeExport.FunDelRow(Cmd: TArrayOfString);
begin

end;

procedure TOfficeExport.FunInsertCol(Cmd: TArrayOfString);
begin

end;

procedure TOfficeExport.FunInsertRow(Cmd: TArrayOfString);
begin

end;

procedure TOfficeExport.FunLoop(Cmd: TArrayOfString; BeginCmdIdx: Integer);
var
  I, Idx: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
  for I := 1 to Length(Cmd) - 1 do begin
    Idx:= FRegList.IndexOfName(Cmd[I]);
    if FRegList.ValueFromIndex[Idx][1] = '@' then
      TDataSet(FRegList.Objects[Idx]).Next
    else FRegList.ValueFromIndex[Idx]:= '#' + IntToStr(StrToInt(Copy(FRegList.ValueFromIndex[Idx], 2, MaxInt)) + 1);
  end;
  FCurrentCom:= BeginCmdIdx - 1;
end;

procedure TOfficeExport.FunMoveData(Cmd: TArrayOfString);
var
  Idx, orgCmd: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
  Idx:= FRegList.IndexOfName(Cmd[1]);
  if FRegList.ValueFromIndex[Idx] = '@' then
    AData:= TDataSet(FRegList.Objects[Idx])
  else ATable:= TVonTable(FRegList.Objects[Idx]);
  if Cmd[2] = 'FIRST' then AData.First
  else if Cmd[2] = 'NEXT' then AData.Next
  else if Cmd[2] = 'PRIOR' then AData.Prior
  else if Cmd[2] = 'LAST' then AData.Last;
end;

procedure TOfficeExport.FunWhile(Cmd: TArrayOfString; EndCmdIdx: Integer);
var
  Idx, orgCmd: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin     //['WHILE',<Prefix>,<condition>]        //循环开始
  orgCmd:= FCurrentCom;
  FCurrentCom:= EndCmdIdx;
  if Cmd[1] = '' then begin  //['WHILE','',<condition>]       //根据循环次数判定是否结束
    if Integer(FLoopList[FLoopList.Count - 1]) >= StrToInt(Cmd[2]) then Exit;
  end else begin
    Idx:= FRegList.IndexOfName(Cmd[1]);
    if FRegList.ValueFromIndex[Idx] = '@' then
      AData:= TDataSet(FRegList.Objects[Idx])
    else ATable:= TVonTable(FRegList.Objects[Idx]);
    if Cmd[2] = 'NEOF' then begin //, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'NEOF=not EOF，即到尾结束'}
      if Assigned(AData)and(AData.Eof) then Exit
      else if Assigned(ATable)and(ATable.RowCount >= Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'NBOF' then begin //NEOF=not EOF, , BOF=BOF, EOF=BOF,
      {$region 'NBOF=not BOF，即到首结束'}
      if Assigned(AData)and(AData.Bof) then Exit
      else if Assigned(ATable)and(0 = Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'EOF' then begin //NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'EOF=BOF，即不到尾结束'}
      if Assigned(AData)and(not AData.Eof) then Exit
      else if Assigned(ATable)and(ATable.RowCount > Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'BOF' then begin //NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'BOF=BOF，即不到首结束'}
      if Assigned(AData)and(not AData.Bof) then Exit
      else if Assigned(ATable)and(0 < Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end;
  end;
  FCurrentCom:= orgCmd;
  FLoopList[FLoopList.Count - 1]:= Pointer(Integer(FLoopList[FLoopList.Count - 1]) + 1);
end;

procedure TOfficeExport.FunWrite(Cmd: TArrayOfString);
var
  Idx: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
  Idx:= FRegList.IndexOfName(Cmd[1]);
  if FRegList.ValueFromIndex[Idx] = '@' then
    AData:= TDataSet(FRegList.Objects[Idx])
  else ATable:= TVonTable(FRegList.Objects[Idx]);
//  if Assigned(AData) then WriteLog(LOG_DEBUG, 'FunWrite ---------', AData.Fields[2].AsString);
end;

class function TOfficeExport.OfficeExport(AFilename: string): TOfficeExport;
var
  FileExt: string;
  function OpenExportor(Exportor: TOfficeExport; ExportFilename: string): TOfficeExport;
  begin
    Result:= Exportor;
    Result.Filename:= ExportFilename;
    Result.Open(AFilename);
  end;
  function NewExportor(Exportor: TOfficeExport; ExportFilename: string): TOfficeExport;
  begin
    Result:= Exportor;
    Result.Filename:= ExportFilename;
    Result.New(AFilename);
  end;
begin
  FileExt:= UpperCase(ExtractFileExt(AFilename));
  if FileExt = '.XLS' then
    Result:= OpenExportor(TExcelExport.Create, AFilename);
  if FileExt = '.XLSX' then
    Result:= OpenExportor(TExcelExport.Create, AFilename);
  if FileExt = '.XLT' then
    Result:= NewExportor(TExcelExport.Create, ChangeFileExt(AFilename, '.xls'));
  if FileExt = '.XLTX' then
    Result:= NewExportor(TExcelExport.Create, ChangeFileExt(AFilename, '.xls'));

  if FileExt = '.DOC' then
    Result:= OpenExportor(TWordExport.Create, AFilename);
  if FileExt = '.DOCX' then
    Result:= OpenExportor(TWordExport.Create, AFilename);
  if FileExt = '.DOT' then
    Result:= NewExportor(TWordExport.Create, ChangeFileExt(AFilename, '.doc'));
  if FileExt = '.DOTX' then
    Result:= NewExportor(TWordExport.Create, ChangeFileExt(AFilename, '.doc'));
end;

procedure TOfficeExport.RegCommand(Cmd: array of string);
var
  FCurrCmdList: TList;
begin
  if Length(Cmd) = 0 then raise Exception.Create('不允许空命令信息注册。');
  Cmd[0]:= UpperCase(Trim(Cmd[0]));
  if Cmd[0] = 'WHILE' then FLoopList.Add(Pointer(FCommandList.AppendRow(Cmd)))
  else if Cmd[0] = 'LOOP' then begin
    if FLoopList.Count = 0 then
      raise Exception.Create('Command "Loop" not found "while".');
    FCommandList.Data[Integer(FLoopList[FLoopList.Count - 1])]:=
      Pointer(FCommandList.AppendRow(Cmd, FLoopList[FLoopList.Count - 1]));
    FLoopList.Delete(FLoopList.Count - 1);
  end else FCommandList.AppendRow(Cmd);
end;

procedure TOfficeExport.RegData(Prefix: string; ADataSet: TVonTable);
begin
  FRegList.AddObject(Prefix + '=#', ADataSet);
  FRegisted:= True;
end;

procedure TOfficeExport.RegTable(Prefix: string; ADataSet: TCustomADODataSet);
begin
  FRegList.AddObject(Prefix + '=@', ADataSet);
  FRegisted:= True;
end;

procedure TOfficeExport.SetFilename(const Value: string);
begin
  FFilename := ExtractFileName(Value);
  FFilePath := ExtractFilePath(Value);
end;

procedure TOfficeExport.SetFilePath(const Value: string);
begin
  FFilePath := Value;
end;

procedure TOfficeExport.WriteData(Prefix: string);
begin
  if Prefix = '' then Exit;
  if(Prefix[1] = '@')or(Prefix[1] = '#')then

end;

procedure TOfficeExport.WriteData;
var
  I: Integer;
begin
  for I := 0 to FRegList.Count - 1 do
    case FRegList.ValueFromIndex[I][1] of
    '@': WriteData(I);
    '#': WriteTable(I);
    end;
end;

procedure TOfficeExport.WriteReg;
var
  I, J: Integer;
  Params: TVonList;
begin
  Params:= TVonList.Create;
  for I := 0 to FRegList.Count - 1 do
    case FRegList.ValueFromIndex[I][1] of
    '@': with TDataSet(FRegList.Objects[I]) do
        for J := 0 to Fields.Count - 1 do
          Params.Add(FRegList.Names[I] + '_' + Fields[J].FieldName);
    '#': with TVonTable(FRegList.Objects[I]) do
        for J := 0 to ColCount - 1 do
          Params.Add(FRegList.Names[I] + '_' + IntToStr(J));
    end;
//  DoSpeicalCommand('WRITETEXT', Params);
  Params.Free;
end;

procedure TOfficeExport.WriteTable(Prefix: string);
begin

end;

{ TExcelExport }

procedure TExcelExport.Close;
begin
  if not FOpened then Exit;
  FExcelBook.Close;
  FOpened:= False;
end;

constructor TExcelExport.Create;
begin
  inherited;
  FExcelApp:= TExcelApplication.Create(nil);
  FExcelBook:= TExcelWorkBook.Create(nil);
  FExcelSheet:= TExcelWorksheet.Create(nil);
  LCID := GetUserDefaultLCID();
end;

destructor TExcelExport.Destroy;
begin
  FExcelApp.Quit;
  FExcelApp.Disconnect;
  FExcelBook.Free;
  FExcelApp.Free;
  inherited;
end;

procedure TExcelExport.DoSpeicalCommand(Cmd: TArrayOfString);
var
  I: Integer;
  ole: OleVariant;
begin
//  if Cmd = 'WRITETEXT' then
//    for I := 0 to Params.Count - 1 do
//      FExcelApp.Cells.Item[1, I + 1].Value2:= Params.Strings[I]
//  else if Cmd = 'COPYPAGE' then begin
//    CurrentSheet.Copy('', '装炉顺序', 1);
//
//  end;
end;

procedure TExcelExport.FunCopy(Cmd: TArrayOfString);
var
  szPage: Integer;
  szSheet: _Worksheet;

  procedure PasteRange(szRange: ExcelRange; Horizontal: Boolean);
  begin
    szSheet:= (FExcelBook.Worksheets[szPage] as _Worksheet);
    szRange.Copy(EmptyParam);
    if Horizontal then begin
      FColOffset[szPage]:= szSheet.UsedRange[LCID].Columns.Count;
      if FColOffset[szPage] = 1 then FColOffset[szPage]:= 0;
      FRowOffset[szPage]:= 0;
    end else begin
      FRowOffset[szPage]:= szSheet.UsedRange[LCID].Rows.Count;
      if FRowOffset[szPage] = 1 then FRowOffset[szPage]:= 0;
      FColOffset[szPage]:= 0;
    end;
  end;
begin
  // ['COPY',<CopyKind>,<page>,<params>]          //复制一个区域或页面到指定页面
  // <CopyKind>: HRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
  //             VRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
  //             HPAGE=水平单页复制，后面参数为复制页页码 <page>
  //             VPAGE=垂直单页复制，后面参数为复制页页码 <page>
  inherited;
  szPage:= StrToInt(Cmd[2]);
  if Cmd[1] = 'HPAGE' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).UsedRange[LCID], True)
  else if Cmd[1] = 'VPAGE' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).UsedRange[LCID], False)
  else if Cmd[1] = 'HRANG' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).Range[Cmd[4], Cmd[5]], True)
  else if Cmd[1] = 'VRANG' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).Range[Cmd[4], Cmd[5]], False);
  szSheet.Cells.Item[FRowOffset[szPage] + 1, FColOffset[szPage] + 1].Select;
  GetCurrentSheet.Paste(EmptyParam, EmptyParam, LCID);
end;

procedure TExcelExport.FunDelCol(Cmd: TArrayOfString);
begin
  inherited;

end;

procedure TExcelExport.FunDelRow(Cmd: TArrayOfString);
begin
  inherited;

end;

procedure TExcelExport.FunInsertCol(Cmd: TArrayOfString);
begin
  inherited;

end;

procedure TExcelExport.FunInsertRow(Cmd: TArrayOfString);
begin
  inherited;

end;

procedure TExcelExport.FunWrite(Cmd: TArrayOfString);
var
  Idx, orgCmd: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
// ['WRITE',<Prefix>,<page>,<ExportTableKind>]  //写数据
  inherited;
  Idx:= FRegList.IndexOfName(Cmd[1]);
  if FRegList.ValueFromIndex[Idx] = '@' then
    AData:= TDataSet(FRegList.Objects[Idx])
  else ATable:= TVonTable(FRegList.Objects[Idx]);
  if Cmd[3] = 'ONLY' then WriteONLYData(Cmd[1], StrToInt(Cmd[2]), AData);
  if Cmd[3] = 'EROW' then WriteEROWData(Cmd[1], StrToInt(Cmd[2]), AData);

end;

function TExcelExport.GetCurrentSheet: TExcelWorksheet;
begin
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _WorkSheet);
  Result:= FExcelSheet;
end;

procedure TExcelExport.New(Filename: string);
begin
  FExcelApp.Connect;
  FExcelApp.Visible[0]:= True;
  FExcelBook.ConnectTo(FExcelApp.Workbooks.Add(Filename, 0));
  FOpened:= True;
end;

procedure TExcelExport.Open(Filename: string);
begin
  FExcelApp.Connect;
  FExcelApp.Visible[0]:= True;
  FExcelBook.ConnectTo(FExcelApp.Workbooks.Open(Filename, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 0));
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _WorkSheet);
  FOpened:= True;
end;

procedure TExcelExport.Prepared;
var
  I: Integer;
begin
  for I := 1 to 10 do begin
    FRowOffset[i]:= 0;
    FColOffset[i]:= 0;
  end;
end;

procedure TExcelExport.Print;
begin
  if not FOpened then Exit;
  Window(FExcelApp.ActiveSheet).PrintPreview(true);
end;

procedure TExcelExport.SaveFile(AFilename: string);
var
  szFilename: OleVariant;
begin
  if not FOpened then Exit;
  if AFilename = '' then szFilename:= FilePath + Filename
  else szFilename:= AFilename;
  CurrentSheet.SaveAs(szFilename);
  FExcelApp.Disconnect;
end;

procedure TExcelExport.WriteData(Index: Integer);
begin
  inherited;
//  case EExportTableKind(Integer(FRegList.Datas[Index])) of
//  ETK_ONLY:  WriteONLYData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_ROWS:  WriteROWSData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_COLS:  WriteCOLSData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_EROW:  WriteEROWData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_ECOL:  WriteECOLData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_PAGE:  WritePAGEData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_RBLK:  WriteRBLKData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_CBLK:  WriteCBLKData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  end;
end;

procedure TExcelExport.WriteECOLData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
begin
  Idx:= -1;
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then
            FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[0, Idx].Insert(xlShiftToRight, xlFormatFromLeftOrAbove);
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[0, Idx].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteEROWData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  szRange: ExcelRange;
  ws: _Worksheet;
begin
  Idx:= 0;
  ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
  ws.Select(EmptyParam, LCID);
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          szRange:= FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange;
          if not Expanded then begin
            if Idx > 0 then begin
              ws.Rows.Item[FRowOffset[Page] + szRange.Row, EmptyParam].Copy(EmptyParam);
              ws.Rows.Item[FRowOffset[Page] + szRange.Row + 1, EmptyParam].Insert(xlShiftUp, xlFormatFromLeftOrAbove);
              Inc(FRowOffset[Page]);
            end;
            Inc(Idx);
            Expanded:= True;
          end;
          ws.Cells.Item[FRowOffset[Page] + szRange.Row,
            FColOffset[Page] + szRange.Column].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteRBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  baseRange: ExcelRange;
begin
  Idx:= -1;
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
  baseRange:= FExcelSheet.UsedRange[0];
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then
            baseRange.Copy(baseRange.Offset[Idx * baseRange.Rows.Count, 0]);
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[Idx * baseRange.Rows.Count, 0].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteCBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  baseRange: ExcelRange;
begin
  Idx:= -1;
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
  baseRange:= FExcelSheet.UsedRange[0];
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then
            baseRange.Copy(baseRange.Offset[0, Idx * baseRange.Columns.Count]);
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[0, Idx * baseRange.Columns.Count].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteCOLSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
begin
  Idx:= -1;
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[0, Idx].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteONLYData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J: Integer;
  szRange: ExcelRange;
  ws: _Worksheet;
begin
  with ADataSet do
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          szRange:= FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange;
          ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
          ws.Cells.Item[FRowOffset[Page] + szRange.Row,
            FColOffset[Page] + szRange.Column].Value2:= Fields[I].AsString;
          System.Break;
        end;
    end;
end;

procedure TExcelExport.WritePAGEData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
begin
  Idx:= -1;
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then begin
            //FExcelBook.Sheets.Copy();
          end;
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[Idx, 0].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteROWSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
begin
  Idx:= -1;
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[Idx, 0].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteTable(Index: Integer);
begin

end;

{ TWordExport }

procedure TWordExport.Close;
begin
  if not FOpened then Exit;
  FWordBook.Close;
  FOpened:= False;
end;

constructor TWordExport.Create;
begin
  inherited;
  FWordApp:= TWordApplication.Create(nil);
  FWordBook:= TWordDocument.Create(nil);
end;

destructor TWordExport.Destroy;
begin
  FWordBook.Free;
  FWordApp.Disconnect;
  FWordApp.Free;
  inherited;
end;

procedure TWordExport.DoSpeicalCommand(Cmd: TArrayOfString);
var
  I: Integer;
begin
//  if Cmd = 'WRITETEXT' then
//    FWordApp.Selection.Range.Text:= Params.Text
end;

function TWordExport.GetCurrentBook: TWordDocument;
begin
  Result:= FWordBook;
end;

procedure TWordExport.New(Filename: string);
var
  szFile: OleVariant;
begin
  FWordApp.Connect;
  FWordApp.Visible:= True;
  szFile:= Filename;
  FWordBook.ConnectTo(FWordApp.Documents.Add(szFile, EmptyParam, EmptyParam, EmptyParam));
  FOpened:= True;
end;

procedure TWordExport.Open(Filename: string);
var
  szFile: OleVariant;
begin
  FWordApp.Connect;
  FWordApp.Visible:= True;
  szFile:= Filename;
  FWordBook.ConnectTo(FWordApp.Documents.Open(szFile, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam));
  FOpened:= True;
end;

procedure TWordExport.Print;
begin
  if not FOpened then Exit;
  FWordBook.PrintPreview;
end;

procedure TWordExport.SaveFile(AFilename: string);
var
  szFilename: OleVariant;
begin
  if not FOpened then Exit;
  if AFilename = '' then szFilename:= FilePath + Filename
  else szFilename:= AFilename;
  FWordBook.SaveAs(szFilename);
end;

procedure TWordExport.WriteData(Index: Integer);
begin
  inherited;
//  case EExportTableKind(Integer(FRegList.Datas[Index])) of
//  ETK_ONLY:  WriteONLYData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_ROWS:  WriteROWSData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_COLS:  WriteCOLSData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_EROW:  WriteEROWData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_ECOL:  WriteECOLData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_PAGE:  WritePAGEData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_RBLK:  WriteRBLKData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  ETK_CBLK:  WriteCBLKData(FRegList.Names[Index], TCustomADODataSet(FRegList.Objects[Index]));
//  end;
end;

procedure TWordExport.WriteCBLKData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, lenPrefix: Integer;
  FieldCode: string;
begin
  for I := 1 to FWordBook.Fields.Count do
    with FWordBook.Fields.Item(I) do begin

      lenPrefix:= Length(Prefix);                       //«A_Delivery»
      FieldCode:= System.Copy(Result.Text, lenPrefix + 3, Length(Result.Text) - lenPrefix - 3);
      if System.Copy(Result.Text, 2, lenPrefix) = Prefix then
        Result.Text:= ADataSet.FieldByName(FieldCode).AsString;
  end;

//  Idx:= -1;
//  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
//  baseRange:= FExcelSheet.UsedRange[0];
//  with ADataSet do while not EOF do begin
//    Expanded:= False;
//    for I := 0 to Fields.Count - 1 do
//      for J:= 1 to FExcelBook.Names.Count do
//        if FExcelBook.Names.Item(J, EmptyParam, EmptyParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
//          if not Expanded then begin
//            Inc(Idx);
//            Expanded:= True;
//          end;
//          if Idx > 0 then
//            baseRange.Copy(baseRange.Offset[0, Idx * baseRange.Columns.Count]);
//          FExcelBook.Names.Item(J, EmptyParam, EmptyParam).RefersToRange.Offset[0, Idx * baseRange.Columns.Count].Value2:= Fields[I].AsString;
//        end;
//    Next;
//  end;
end;

procedure TWordExport.WriteCOLSData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteECOLData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteEROWData(Prefix: string; ADataSet: TCustomADODataSet);
var
  I, J, Idx: Integer;
  D: OleVariant;
  Expanded: Boolean;
  szTable: Table;
  szList: TStringList;
  R_C: PX_Y;
begin
  szList:= TStringList.Create;
  with ADataSet do                     //寻找表格位置索引
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FWordBook.Fields.Count do
        if SameText(FWordBook.Fields.Item(J).Result.Text, '«' + Prefix + '_' + Fields[I].FieldName + '»')then begin
          System.New(R_C);
          R_C.X:= FWordBook.Fields.Item(J).Result.Cells.Item(1).ColumnIndex;
          R_C.Y:= FWordBook.Fields.Item(J).Result.Cells.Item(1).RowIndex;
          szList.AddObject(Fields[I].FieldName, TObject(R_C));
          szTable:= FWordBook.Fields.Item(J).Result.Tables.Item(1);
          System.Break;
        end;
    end;
  J:= 0;
  ADataSet.First;
  with ADataSet do
    while not EOF do begin
      Expanded:= False;
      for I := 0 to Fields.Count - 1 do begin
        Idx:= szList.IndexOf(Fields[I].FieldName);
        if Idx < 0 then Continue;
        R_C:= PX_Y(szList.Objects[Idx]);
        if(not Expanded)then begin
          if J < RecordCount - 1 then begin
            szTable.Cell(R_C.Y + J, R_C.X).Select;
            D:= 1;
            FWordApp.Selection.InsertRowsAbove(D);
          end;
          Expanded:= True;
          Inc(J);
        end;
        szTable.Cell(R_C.Y + J - 1, R_C.X).Range.Text:= Fields[I].AsString;
      end;
      Next;
    end;
  szList.Free;
end;

procedure TWordExport.WriteONLYData(Prefix: string; ADataSet: TCustomADODataSet);
var
  I, lenPrefix: Integer;
  FieldCode: string;
begin
  for I := 1 to FWordBook.Fields.Count do
    with FWordBook.Fields.Item(I) do begin
      lenPrefix:= Length(Prefix);                       //«A_Delivery»
      FieldCode:= System.Copy(Result.Text, lenPrefix + 3, Length(Result.Text) - lenPrefix - 3);
      if System.Copy(Result.Text, 2, lenPrefix) = Prefix then
        Result.Text:= ADataSet.FieldByName(FieldCode).AsString;
  end;
end;

procedure TWordExport.WritePAGEData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteRBLKData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteROWSData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, J, Idx, R, C: Integer;
  Expanded: Boolean;
  szTable: Table;
begin
  with ADataSet do begin
    Idx:= RecordCount;
    Last;
    while not BOF do begin
      Expanded:= False;
      for I := 0 to Fields.Count - 1 do
        for J:= 1 to FWordBook.Fields.Count do
          if FWordBook.Fields.Item(J).Result.Text = '«' + Prefix + '_' + Fields[I].FieldName + '»' then begin
            if not Expanded then begin
              Dec(Idx);
              Expanded:= True;
              szTable:= FWordBook.Fields.Item(J).Result.Tables.Item(1);
              R:= FWordBook.Fields.Item(J).Result.Cells.Item(1).RowIndex;
            end;
            C:= FWordBook.Fields.Item(J).Result.Cells.Item(1).ColumnIndex;
            FWordBook.Fields.Item(J).Select;
            szTable.Cell(R + Idx, C).Range.Text:= Fields[I].AsString;
          end else WriteLog(LOG_Debug, 'WriteROWSData',
            FWordBook.Fields.Item(J).Result.Text + ' ? ' + Prefix + '_' + Fields[I].FieldName);
      Prior;
    end;
  end;
end;

procedure TWordExport.WriteTable(Index: Integer);
begin

end;

end.
